{
======================================================================
Project  : Firebird Control Center
Unit     : uService.pas
Purpose  : Access the Windows NT Service Manager API
Author   : Achim Kalwa <delphi@achim-kalwa.de>
Compiler : Borland Delphi 5.01
----------------------------------------------------------------------
History:
2002-03-04, Kalwa:
- Form/Unit created

2002-03-17, Kalwa:
- BUGFIX: In DoQueryServiceStatus, DoChangeServiceConfig,
  the memory allocated for PServiceConfig was never freed.

2004-05-12, Kalwa:
- NEW: Classes TServiceListItem and TServiceList.
- NEW: function GetDependentServices retrieves a list of dependent
  services.
======================================================================
}
{$I fbcc.inc}
unit uService;

interface

uses
  SysUtils,
  Classes,
  Contnrs,
  Windows,
  WinSvc;

type
  TSvcStatus = (ssUnknown,                // enumeration of service status
                ssStopped,
                ssStartPending,
                ssStopPending,
                ssRunning,
                ssContinuePending,
                ssPausePending,
                ssPaused,
                ssError);

  TServiceListItem = Class(TObject)
    ServiceName : string;
    DisplayName : string;
  end;

  TServiceList = Class(TObjectList)
  private
    function GetItem(ndx : Integer) : TServiceListItem;
  public
    property Items[ndx: Integer] : TServiceListItem read GetItem;
    function AddItem(const aServiceName, aDisplayName: string) : TServiceListItem;
    function DisplayNames : string;
  end;

function GetWinSysDir : String;
function IsAdministrator: Boolean;
function GetServiceStatus(ServiceName : String) : TSvcStatus;
function DoStartService(ServiceName : string) : TSvcStatus;
function DoStopService(ServiceName : string) : TSvcStatus;
function DoChangeServiceConfig(ServiceName : string; Enabled, AutoStart : Boolean) : Boolean;
function DoQueryServiceConfig(ServiceName : string; var DisplayName : string; var Enabled, AutoStart, Running : Boolean) : Boolean;
function GetDependentServices(ServiceName : string; Active: Boolean; ServiceList: TServiceList) : Boolean;

implementation

uses
  Controls,
  Forms;

{ TServiceList }

function TServiceList.AddItem(const aServiceName, aDisplayName: string): TServiceListItem;
begin
  Result := TServiceListItem.Create;
  Result.ServiceName := aServiceName;
  Result.DisplayName := aDisplayName;
  Self.Add(Result);
end;

function TServiceList.DisplayNames: string;
var
  i : Integer;
begin
  Result := '';
  for i := 0 to Count-1 do begin
    if Length(Result) > 0 then Result := Result + ', ';
    Result := Result + GetItem(i).DisplayName;
  end;
end;

function TServiceList.GetItem(ndx: Integer): TServiceListItem;
begin
  Result := TServiceListItem(inherited Items[ndx]);
end;

{ Functions }

function GetWinSysDir : String;
var
  aLen   : Integer;
begin
  SetLength(Result, MAX_PATH);
  aLen := Windows.GetSystemDirectory(PChar(Result), MAX_PATH);
  SetLength(Result, aLen);
end;

function IsAdministrator: Boolean;
var
  hServiceManager : SC_HANDLE;
begin
  hServiceManager := OpenSCManager(nil, nil, SC_MANAGER_ALL_ACCESS);
  if hServiceManager > 0 then begin
    Result := True;
    CloseServiceHandle(hServiceManager);
  end
  else
    Result := False;
end;

function GetServiceStatus(ServiceName : String) : TSvcStatus;
{ retrieve status of given service }
var
  dwStatus         : DWord;
  hService         : SC_HANDLE;
  hServiceManager  : SC_HANDLE;
  ServiceStatus    : TServiceStatus;
Begin
  dwStatus := Ord(ssError);
  hServiceManager := OpenSCManager(nil, nil, SC_MANAGER_CONNECT);

  if hServiceManager > 0 then begin
    hService := OpenService(hServiceManager,
                            pChar(ServiceName),
                            SERVICE_QUERY_STATUS);
    if hService > 0 then begin
      if QueryServiceStatus(hService, ServiceStatus) then begin
        dwStatus := ServiceStatus.dwCurrentState;
      end;
      CloseServiceHandle(hService);
    end;
  end;
  CloseServiceHandle(hServiceManager);
  Result := TSvcStatus(dwStatus);
end;                                    { GetServiceStatus }

function DoStartService(ServiceName : string) : TSvcStatus;
{ start a installed service by name. Returns the service status }
var
  hService         : SC_HANDLE;
  hServiceManager  : SC_HANDLE;
  pDummy           : PChar;
  Tries            : Integer;
begin
  Result := GetServiceStatus(ServiceName);
  if Result <> ssStopped then Exit;

  Screen.Cursor := crHourGlass;
  hServiceManager := OpenSCManager(nil, nil, SC_MANAGER_CONNECT);

  if hServiceManager > 0 then begin
    hService := OpenService(hServiceManager,
                            PChar(ServiceName),
                            SERVICE_START);
    if hService > 0 then begin
      pDummy := nil;
      if StartService(hService, 0, pDummy) then begin
        Tries := 10;
        repeat
          Sleep(1000);
          Result := GetServiceStatus(ServiceName);
          Dec(Tries);
        until (Tries = 0) or (Result = ssRunning);
      end
      else begin
        Result := ssError;
      end;
      CloseServiceHandle(hService);
    end;
  end;
  CloseServiceHandle(hServiceManager);
  Screen.Cursor := crDefault;
end; { DoStartService }

function DoStopService(ServiceName : string) : TSvcStatus;
{ stop a running service by name. Returns the service status }
var
  hService         : SC_HANDLE;
  hServiceManager  : SC_HANDLE;
  ServiceStatus    : TServiceStatus;
  Tries            : Integer;
begin
  Result := GetServiceStatus(ServiceName);
  if Result <> ssRunning then Exit;

  Screen.Cursor := crHourGlass;
  hServiceManager := OpenSCManager(nil, nil, SC_MANAGER_ALL_ACCESS);
  if hServiceManager > 0 then begin
    hService := OpenService(hServiceManager,
                            PChar(ServiceName),
                            GENERIC_EXECUTE);
    if hService > 0 then begin
      if ControlService(hService, SERVICE_CONTROL_STOP, ServiceStatus) then begin
        Tries := 10;
        Repeat
          Sleep(1000);
          Dec(Tries);
          Result := GetServiceStatus(ServiceName);
        until (Tries = 0) or (Result = ssStopped);
      end
      else
        Result := ssError;

      CloseServiceHandle(hService);
    end;
  end;
  CloseServiceHandle(hServiceManager);
  Screen.Cursor := crDefault;
end;   { DoStopService }

function DoQueryServiceConfig(ServiceName : string; var DisplayName : string; var Enabled, AutoStart, Running : Boolean) : Boolean;
{ retrieves information for a named service. }
var
  hService         : SC_HANDLE;
  hServiceManager  : SC_HANDLE;
  BytesNeeded      : DWORD;
  PServiceConfig   : PQueryServiceConfig;
  ServiceStatus    : TServiceStatus;
begin
  Result := False;
  DisplayName := '';
  Enabled     := False;
  AutoStart   := False;
  hServiceManager := OpenSCManager(nil, nil, SERVICE_QUERY_CONFIG);
  if hServiceManager > 0 then begin
    hService := OpenService(hServiceManager,
                            PChar(ServiceName),
                            SERVICE_QUERY_CONFIG or SERVICE_QUERY_STATUS);
    if hService > 0 then begin
      BytesNeeded := 0;

      { Read Service Configuration }
      QueryServiceConfig(hService, nil, 0, BytesNeeded);
      GetMem(PServiceConfig, BytesNeeded);
      if not QueryServiceConfig(hService, PServiceConfig, BytesNeeded, BytesNeeded)
      then RaiseLastWin32Error;

      DisplayName := StrPas(PServiceConfig^.lpDisplayName);
      case PServiceConfig^.dwStartType of
        SERVICE_AUTO_START:
          begin
            Enabled := True;
            AutoStart := True;
          end;
        SERVICE_DEMAND_START:
          begin
            Enabled := True;
            AutoStart := False;
          end;
        SERVICE_DISABLED:
          begin
            Enabled := False;
            AutoStart := False;
          end;
      end; { case }

      { Read Service Status }
      FillChar(ServiceStatus, SizeOf(ServiceStatus), 0);
      if QueryServiceStatus(hService, ServiceStatus) then begin
        Running := (ServiceStatus.dwCurrentState = SERVICE_RUNNING);
      end
      else
        RaiseLastWin32Error;

      CloseServiceHandle(hService);
      FreeMem(PServiceConfig);
    end;
  end;
  CloseServiceHandle(hServiceManager);
  Screen.Cursor := crDefault;
end;                                    { DoQueryServiceStatus }

function DoChangeServiceConfig(ServiceName : string; Enabled, AutoStart : Boolean) : Boolean;
{ changes a service's statup configuration } 
var
  hService         : SC_HANDLE;
  hServiceManager  : SC_HANDLE;
  NewStartType     : Integer;
  DisplayName      : string;
  BytesNeeded      : DWORD;
  PServiceConfig   : PQueryServiceConfig;

begin
  Result := False;
  hServiceManager := OpenSCManager(nil, nil, SC_MANAGER_ALL_ACCESS);
  if hServiceManager > 0 then begin
    hService := OpenService(hServiceManager,
                            PChar(ServiceName),
                            SERVICE_QUERY_CONFIG or SERVICE_CHANGE_CONFIG);
    if hService > 0 then begin
      BytesNeeded := 0;
      QueryServiceConfig(hService, nil, 0, BytesNeeded);
      GetMem(PServiceConfig, BytesNeeded);
      QueryServiceConfig(hService, PServiceConfig, BytesNeeded, BytesNeeded);
      DisplayName := StrPas(PServiceConfig^.lpDisplayName);
      if Enabled then begin
        if AutoStart
        then NewStartType := SERVICE_AUTO_START
        else NewStartType := SERVICE_DEMAND_START;
      end
      else
        NewStartType := SERVICE_DISABLED;

      Result := ChangeServiceConfig(
        hService,                       { Handle of Service }
        SERVICE_NO_CHANGE,              { don't change service type }
        NewStartType,                   { set new start type }
        SERVICE_NO_CHANGE,              { don't change ErrorControl }
        nil,                            { don't change BinaryPathName }
        nil,                            { don't change LoadGroupOrder }
        nil,                            { don't change dwTagID }
        nil,                            { don't change Dependencies }
        nil,                            { don't change ServiceStartName }
        nil,                            { don't change Password (if any) }
        PChar(DisplayName));            { Display name }

      CloseServiceHandle(hService);
      FreeMem(PServiceConfig);
    end;
  end;
  CloseServiceHandle(hServiceManager);
  Screen.Cursor := crDefault;
end;                                    { DoChangeServiceConfig }

function GetDependentServices(ServiceName : string; Active: Boolean; ServiceList: TServiceList) : Boolean;
var
  hService           : SC_HANDLE;
  hServiceManager    : SC_HANDLE;
  PServiceStatus     : PEnumServiceStatus;
  P                  : PEnumServiceStatus;
  ServiceState       : DWORD;
  ServicesCount      : DWORD;
  BytesNeeded        : DWORD;
  i                  : Integer;

begin
  Result := False;
  if not Assigned(ServiceList) then Exit;

  if Active
  then ServiceState := SERVICE_ACTIVE
  else ServiceState := SERVICE_INACTIVE;

  hServiceManager := OpenSCManager(nil, nil, SC_MANAGER_ALL_ACCESS);
  if hServiceManager > 0 then begin
    hService := OpenService(hServiceManager,
                            PChar(ServiceName),
                            SERVICE_ENUMERATE_DEPENDENTS );
    if hService > 0 then begin
      Result := True;
      BytesNeeded := 0;
      PServiceStatus := nil;
      EnumDependentServices(hService,
                            ServiceState,
                            PServiceStatus^, 0,
                            BytesNeeded,
                            ServicesCount);
      if BytesNeeded > 0 then begin
        GetMem(PServiceStatus, BytesNeeded);
        EnumDependentServices(hService,
                              ServiceState,
                              PServiceStatus^,
                              BytesNeeded,
                              BytesNeeded,
                              ServicesCount);
        for i := 0 to ServicesCount-1 do begin
          P := PServiceStatus;
          ServiceList.AddItem(StrPas(P^.lpServiceName), StrPas(P^.lpDisplayName));
          Inc(P);
        end;
        FreeMem(PServiceStatus);
      end;
      CloseServiceHandle(hService);
    end;
  end;
  CloseServiceHandle(hServiceManager);
  Screen.Cursor := crDefault;
end;

end.
